home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ftpwit1a / ftplist.frm < prev    next >
Text File  |  1999-09-10  |  6KB  |  191 lines
  1. VERSION 5.00
  2. Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
  3. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  4. Begin VB.Form ftpList 
  5.    BorderStyle     =   3  'Fixed Dialog
  6.    Caption         =   "FTP Transfer"
  7.    ClientHeight    =   5088
  8.    ClientLeft      =   1392
  9.    ClientTop       =   1608
  10.    ClientWidth     =   6876
  11.    ClipControls    =   0   'False
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    PaletteMode     =   1  'UseZOrder
  16.    ScaleHeight     =   5088
  17.    ScaleWidth      =   6876
  18.    ShowInTaskbar   =   0   'False
  19.    Begin VB.TextBox txtCopyTo 
  20.       BeginProperty Font 
  21.          Name            =   "MS Sans Serif"
  22.          Size            =   9.6
  23.          Charset         =   0
  24.          Weight          =   700
  25.          Underline       =   0   'False
  26.          Italic          =   0   'False
  27.          Strikethrough   =   0   'False
  28.       EndProperty
  29.       Height          =   372
  30.       Left            =   3480
  31.       TabIndex        =   2
  32.       Top             =   1800
  33.       Width           =   3132
  34.    End
  35.    Begin VB.ListBox lstFiles 
  36.       BeginProperty Font 
  37.          Name            =   "MS Sans Serif"
  38.          Size            =   7.8
  39.          Charset         =   0
  40.          Weight          =   700
  41.          Underline       =   0   'False
  42.          Italic          =   0   'False
  43.          Strikethrough   =   0   'False
  44.       EndProperty
  45.       Height          =   3696
  46.       ItemData        =   "ftpList.frx":0000
  47.       Left            =   240
  48.       List            =   "ftpList.frx":0002
  49.       TabIndex        =   1
  50.       Top             =   1200
  51.       Width           =   3012
  52.    End
  53.    Begin MSComctlLib.ProgressBar ProgressBar1 
  54.       Height          =   252
  55.       Left            =   240
  56.       TabIndex        =   0
  57.       Top             =   480
  58.       Width           =   3852
  59.       _ExtentX        =   6795
  60.       _ExtentY        =   445
  61.       _Version        =   393216
  62.       BorderStyle     =   1
  63.       Appearance      =   1
  64.       MousePointer    =   9
  65.       Scrolling       =   1
  66.    End
  67.    Begin InetCtlsObjects.Inet Inet1 
  68.       Left            =   4440
  69.       Top             =   480
  70.       _ExtentX        =   804
  71.       _ExtentY        =   804
  72.       _Version        =   393216
  73.       AccessType      =   1
  74.       Protocol        =   2
  75.       RemotePort      =   21
  76.       URL             =   "ftp://"
  77.       RequestTimeout  =   1800
  78.    End
  79.    Begin VB.Label Label2 
  80.       Caption         =   "To download a file specify output and doubleclick doublckicking on directory name will show directory content."
  81.       Height          =   612
  82.       Left            =   3480
  83.       TabIndex        =   4
  84.       Top             =   3000
  85.       Width           =   3372
  86.    End
  87.    Begin VB.Label Label1 
  88.       Alignment       =   2  'Center
  89.       Caption         =   "Copy to:"
  90.       BeginProperty Font 
  91.          Name            =   "MS Sans Serif"
  92.          Size            =   9.6
  93.          Charset         =   0
  94.          Weight          =   700
  95.          Underline       =   0   'False
  96.          Italic          =   0   'False
  97.          Strikethrough   =   0   'False
  98.       EndProperty
  99.       Height          =   492
  100.       Left            =   3480
  101.       TabIndex        =   3
  102.       Top             =   1320
  103.       Width           =   3132
  104.    End
  105. End
  106. Attribute VB_Name = "ftpList"
  107. Attribute VB_GlobalNameSpace = False
  108. Attribute VB_Creatable = False
  109. Attribute VB_PredeclaredId = True
  110. Attribute VB_Exposed = False
  111. Option Explicit
  112.  
  113. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  114.  
  115. ' lists the files from current directory
  116.  
  117. Public Sub subShowFiles(var As Variant)
  118.  
  119.   Dim strArray() As String
  120.   Dim intTemp As Integer
  121.    lstFiles.Clear
  122.    
  123.    strArray = Split(CStr(var), Chr(13) & Chr(10))
  124.    lstFiles.AddItem ("../")  ' to go one level up on non UNIX based stations
  125.    For intTemp = 0 To UBound(strArray)
  126.       lstFiles.AddItem (strArray(intTemp))
  127.    Next
  128.    
  129.  
  130. End Sub
  131.  
  132.  
  133. Private Sub lstFiles_DblClick()
  134.  
  135. On Error GoTo errorhandler
  136.  
  137. Dim strFile As String
  138. Dim bolFlag As Boolean
  139.  
  140. MousePointer = vbHourglass
  141.  
  142. With Inet1
  143.  If (Left(lstFiles.Text, 2) = "./" Or Left(lstFiles.Text, 3) = "../" Or Right(lstFiles.Text, 1) = "/") Then
  144.    ' Clicking on the directory name
  145.    .Execute , "cd " & lstFiles.Text
  146.    .Execute , "DIR"
  147.    subShowFiles (.GetChunk(1024))
  148.    
  149.  Else       ' clicking on the file name
  150.    bolFlag = True
  151.    strFile = subDetermineOutputFileName
  152.    .Execute , "size " & lstFiles.Text  ' size of file to download
  153.    ProgressBar1.Max = .GetChunk(1024)
  154.    .Execute , "get " & lstFiles.Text & " " & strFile
  155.    .Execute , "pwd"  ' Forcing trappable error
  156.    MsgBox "Download complete"
  157.    ProgressBar1.Value = 0
  158.    bolFlag = False
  159.  End If
  160. End With
  161.  
  162. MousePointer = vbDefault
  163.  
  164. errorhandler:
  165.    Select Case Err.Number
  166.    Case 35764        '  Still executes last command
  167.    DoEvents
  168.    If bolFlag Then        ' File transfer
  169.     If Not (Dir(strFile) = "") Then
  170.      ProgressBar1.Value = FileLen(strFile)       ' Updating progress bar
  171.      ProgressBar1.ToolTipText = CInt(ProgressBar1.Value * 100 / ProgressBar1.Max) & "% transmitted"
  172.     End If
  173.    End If
  174.    Resume
  175.   End Select
  176. End Sub
  177.  
  178. ' determines the name of output file since in ftp there are several syntax options
  179.  
  180. Private Function subDetermineOutputFileName() As String
  181.  
  182.  If Right(txtCopyTo.Text, 1) = "\" Then
  183.    subDetermineOutputFileName = txtCopyTo.Text & lstFiles.Text
  184.  ElseIf Right(txtCopyTo.Text, 1) = ":" Then
  185.    subDetermineOutputFileName = txtCopyTo.Text & "\" & lstFiles.Text
  186.  Else
  187.    subDetermineOutputFileName = txtCopyTo.Text
  188.  End If
  189.  
  190. End Function
  191.